00100	C  SUBRS  WORDS, TYPE, SETLET, SETNUM , NEWR
00200	
00300		SUBROUTINE WORDS
00400		COMMON R2,JA,RC,J3,R3,R4,R5,R6,R7,X,IA,N
00500		1,Z,J,KN,ISET,Q(28) /PTR/PWDS(250),ITEM,LL,IS,IX
00550	C  /SCX/ IS ALSO IN SCMSS, NOTBMS, RHYTH, BEAMS, NEWR(IN LOOP.FAI)
00600		COMMON/SCX/RHY(4),JALPHA(22),J4,L,Y,K,RX,RZ,RA,J5
00700		1/XRN/RN(4000) /ALF/INP(72),ML
00800		DATA KSLA/'/'/,IBLA/' '/
00900		1,JALPHA/',','-','.','=','(',')','+','*'
01000		1 ,':',';','"',' ','$','%','&','@','#','<','>',1H','?','!'/
01100	C   FOR ENTERING TEXT: 16, POS., STF., NT#., SIZE,  RHYTHM≠0
01200	C  R6 ≠0 CALLS NOTE NUM. SETUP
01300		CALL TYPE
01400		DO 31 KN=72,1,-1
01500	31	IF(INP(KN).NE.IBLA)GO TO 33
01600	C  KN=NUM OF CHARACTERS
01700	C  DON'T END WITH '*' IN 'LETTERS' INPUT!!!!!!!!
01800	C  , - . = ( ) + * : ; " BLANK (FONTS) ' --THIS IS ORDER PAST ALPHAB.
01900	C  48 $=UPPER CASE, 49 %=LOWER, 50 &=NON-ITALICS, 51 @=ITALICS
02000	C  52 #=RETURN TO PRIMITVE FONT, 53 <=OPEN, 54 >=FILLED. ('=55)
02100	33	L=1
02105		RC=0
02110		IF(INP(KN).EQ.KSLA)GO TO 133
02120		KN=KN+1
02130		INP(KN)=KSLA
02140	C  SO TRAILING BLANKS ARE DELETED.
02200	133	LL=1
02205		RZ=0 
02210		ISET=IS
02220		IF(R3.LT.1000)GO TO 233
02225		RZ=1
02230		R3=R3-1000.
02240		RC=R3
02250	C  ADD 1000 TO POSITION (R3+1000) FOR CENTERING AT POS. R3.
02300	233	RA=R3
02400	C   RA= ADDS UP TOTAL SPACE NEEDED
02500		RX=0
02800	C  FOR SETLET
02900	368	RN(IS+1)=16
03000		RN(IS+3)=RA
03100	C  NEXT IS A MAGIC NUMBER FOR SPACING LETTERS.
03200	CC	Y=39.6*RSTJ3
03300	C  RBL IS FOR CONTROL(NON-LETTERS, ETC.) CHARACTERS.
03400		RN(IS+2)=R2
03500		RN(IS+4)=R4
03600		CALL NOZERO(R5)
03700		RN(IS+5)=R5
03800	
03900		DO 364 J5=6,8
04000		Z=0
04100		DO 363 J4=1,4
04200	361	IA=INP(L)
04300		IF(IA.NE.KSLA)GO TO 365
04400	C  NEG. SPACE IS ENTERED IN P1 FOR EACH "FIRST" ITEM.
04500		J3=J4
04600		DO 367 KA=J5,8
04700		X=.990
04800		DO 366 K=J3,4
04900		Z=Z+X
05000	366	X=X*100.0
05100		RN(IS+KA)=Z
05200		J3=1
05300	367	Z=0
05400		L=L+1
05500	C  L=CHARACTER COUNTER
05600		GO TO 369
05700	365	DO 362 J=1,22
05800		IF(IA.NE.JALPHA(J))GO TO 362
05900		N=35+J
06000	C  FOUND A SPECIAL CHARACTER.
06010		K=N
06055		IFNT=0
06100		GO TO 39
06200	362	CONTINUE
06300	38	N=10-('A'-INP(L))/536870912
06400	C   MAGIC NUMBER TO FIND LETTERS
06500		IF(N.LT.10)N=N+7
06510		K=N
06520		IF(KFNT)IFNT=0
06550		IF(N.LT.40)GO TO 39
06560		N=N+28
06565		KFNT=-1
06567	C  TO INITIALIZE AUTOMATIC LOWER CASE SYSTEM.
06570		K=N-60
06571	C  K IS ACTUAL LETTER NUMB. (a=10, ETC.)
06572		IFNT=-1
06575	C LOWER CASE LETTERS ARE 60 .GT. UPPER. A=10, a=70, b=71, etc.
06600	39	L=L+1
06700	C  BLANK=99(=47)
06800		CALL SPACER(K,IFNT,RX,3.32)
06900	C  NUM↑↑=19.7/5.96  FOR BASIC SPACE PER LETTER.
07000	C  GET SPACE FOR THIS LETTER.
07100		X=N
07200		IF(J4.EQ.2)X=X*100.
07300		IF(J4.EQ.4)X=X/100.
07400		IF(J4.EQ.1)X=X*10000.
07500	363	Z=Z+X
07600	364	RN(IS+J5)=Z
07700	369	RN(IS+9)=RX
07800		RN(IS+10)=RZ
07850		IF(RC.NE.0)RN(IS+10)=RC
07875		RC=0
07900	C  FOR CONTINUATION
08000		RA=RA+RX*R5
08050		IF(IA.EQ.KSLA)RA=RA+5
08075	C  SPACES GROUPS DIVIDED BY SLASHES
08100		RX=0
08200		RN(IS)=7+RZ
08300		IS=IS+10+RZ
08400		LL=LL+1
08500		PWDS(ITEM+LL)=IS
08600	C  PUT IT IN THE PNTR ARRAY
08700		RZ=1.
08800		IF(IA.EQ.KSLA)RZ=0
08900		IF(L.LE.KN)GO TO 368
09000	
09100		INP(1)=0
09200	C   SO IT WON'T FIND A COMMAND IN THE MAIN PROG.
09300		IF(R6.NE.0)CALL SETLET
09325		IF(KFNT)IFNT=0
09350		KFNT=0
09400		END
09500	C  PACKS 4 CHARS/WD, 3 WDS/ITEM.  ORDER=[, - . = ( )]  000000.00
09600	
09700		SUBROUTINE TYPE
09800		COMMON/ALF/INP(72),ML
09900		TYPE 8005
10000		ACCEPT 2114,INP
10100	2114	FORMAT(72A1)
10200	8005	FORMAT(' TYPE --'/)
10300		END
10400	
10600		SUBROUTINE SETLET
10800		COMMON/SCM/V(78),Y,LCNT,STAFF,JLIST(200),REND
10900		COMMON R2,JA,CENTR,J2,R3,R4,R5,RJQ(17),JQ(14),M,K,J,X,A,B
11000		1 /FLM/RPOS(2,300) /PTR/PWDS(250),ITEM,L,I,IX /XRN/RN(4000)
11100		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
11110		DIMENSION SU(320)
11146		COMMON/POSI/STF(-3/4),J102,POS/DPY/ST(4000),WDS(250),MEDIT,IGO
11200		EQUIVALENCE (J5,JQ(3)),(ISET,RJQ(9)),(SU(1),ST(3600))
11250		DATA DISP/0.0/
11300		M=1
11350		R4=20
11400		RPOS(1,1)=0
11500		DO 1 K=1,ITEM
11600		IF(FINDIT(K))GO TO 1
11700	C SKIPS NON-NOTES AND WRONG STAFF
11800		M=M+1
11900		RPOS(1,M)=RN(L+3)
12100	1	CONTINUE
12150		IF(M.EQ.1)RETURN
12175	C  M=1 MEANS NO NOTES ON THIS LINE
12200	CXX	CALL SETNUM
12210		CALL DPYSET(3,SU,320)
12222		CALL DPYBRT(6)
12234	CC	R6=1
12246		POS=STF(IFIX(R2))
12282		J5=1
12300		CALL SORT2(RPOS,M)
12400		K=2
12500	22	IF(IFIX(RPOS(1,K)*100.).NE.IFIX(RPOS(1,K-1)*100.))GO TO 2
12550	C  ROUNDS OFF POSITION TO 2 DECI. PLACES
12600		M=M-1
12700		DO 20 J=K,M
12800	20	RPOS(1,J)=RPOS(1,J+1)
12900	C  DELETES DOUBLE-STOPS - DOESN'T PUT NUM OVER 1ST NOTE.
13000		GO TO 22
13100	2	K=K+1
13200		IF(K.LT.M)GO TO 22
13300		DO 4 K=2,M
13400		R3=RHORZ(RPOS(1,K))
13500		CALL PNUM
13600		J5=J5+1
13700	4	IF(J5.EQ.10)J5=0
13800		CALL DPYOUT(3)
13900		CALL SETPOG(1)
14000		RPOS(1,M+1)=200
14100		J=1
14200		CALL TYPE
14300		REREAD F78F,V
14400		X=V(J)+1
14600	3	K=X
14700		A=RPOS(1,K)
14800		B=RPOS(1,K+1)
14900		RN(ISET+3)=A+(B-A)*(X-K)+DISP
14950	C  DISP IS DISPLACEMENT OF CURRENT LETTERS.
15000		IF(RN(ISET+4).NE.0)GO TO 5
15100		RN(ISET+4)=V(J+1)
15200		J=J+2
15300		GO TO 6
15400	C IF P4≠0 TYPE ONLY 1 # FOR EACH ITEM. ALL ITEMS WILL BE AT VRT PS OF P4
15500	C TYPE Nn, Vert pos/Nn, Vert pos/  OR  Nn/Nn/ (if P4≠0)
15600	5	J=J+1
15700	6	ISET=ISET+RN(ISET)+3
15710		IF(RN(ISET).EQ.8)GO TO 6
15720	C  =8 MEANS MORE LETTERS TO COME.
15800		X=V(J)+1
15900		IF(X.GT.1)GO TO 3
16000	C CAN'T PUT LETTER AT POS. 0 *********
16100		END
16200	
21700	CF	SUBROUTINE NEWR
21800	CF	COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
21900	CF	COMMON/XRN/RN(4000)
22000	CF	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
22100	CF	COMMON/SCX/RHY(4),JALPHA(22),JX,U,JZ,IRHY,J4,KA,KB,IZ
22200	CF	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
22300	CF	1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
22400	CF	DIMENSION R(10,80)
22500	CF	EQUIVALENCE (R,RN(3001))
22600	
22700	CF	IF(MODE.NE.1)GO TO 1
22800	CF	IK=IS
22900	CF	JIT=ITEM
23000	CF1	IS=IK
23100	CF	ITEM=JIT+1
23200	C  MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
23300	CF	DO 2 K=1,IZ
23400	CF	IF(R(8,K).EQ.9999.)GO TO 2
23500	C  SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
23600	C  JUMP FOR BEAM CONT.
23700	CF	IEND=-1
23750	CF	RN(IS+3)=0
23760	CF	RN(IS+2)=0
23800	C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
23900	CF	DO 3 L=9,1,-1
24000	CF	A=R(L,K)
24100	CF	IF(A.NE.0)GO TO 77
24150	CF	IF(IEND)GO TO 3
24200	CF77	IF(IEND)IEND=L
24300	CF	RN(IS+L)=A
24400	CF3	CONTINUE
24500	CF	IF(IEND.LT.3)IEND=3
24700	CF	CALL UPDATE(IEND-2)
24800	CF2	CONTINUE
24900	CF	END